home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-05-01 | 7.9 KB | 248 lines | [TEXT/PJMM] |
- unit ShowInit75;
-
- interface
-
- {$ifc undefined THINK_Pascal}
- uses
- Types;
- {$endc}
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Set this to 1 if you want to compile ShowInit-7 into a stand-alone resource. I don't recommend it; see notes below. }
-
- procedure ShowIcon7 (iconFamilyID: integer; advance: Boolean);
-
- implementation
-
- { ShowInit-7 - version 1.0.4, April 25th, 1995 }
- { This code is intended to let INIT writers easily display an icon at startup time. }
-
- { I have found that there are many snippets out there showing how to do this, but all of those I tried were }
- { unnecessarily complex and/or had bugs. I would like to make widely available a version that is as simple }
- { and bug-free as possible. If you feel that this code needs enhancements, please let me know so that I can roll them in. }
-
- { This version features: }
- { - Short and readable code. }
- { - Correctly wraps around when more than one row of icons has been displayed. }
- { - works with System 6 }
- { - Built with Universal Headers & CodeWarrior. Slight changes should suffice to accommodate other headers/compilers. }
-
- { Written by François Pottier (pottier@clipper.ens.fr), with thanks to the numerous authors I stole code from. }
- { This code is free for use in any project. }
-
- { Hacked by Peter N Lewis <peter@mail.peter.com.au>. I mostly just merged in some of }
- { Jim Walker's <JWWalker@aol.com> code. }
-
- { --------------------------------------------------------------------------------------------------------------------- }
-
- { Version History: }
- { 1.0: }
- { Initial release }
- { 1.0.1: }
- { Added qdGlobalsPtr for QuickDraw to store a pointer into. I hadn't seen this bug because it didn't crash a Power Mac! }
- { 1.0.2: }
- { Added a C equivalent for CheckSum. }
- { Fixed a problem which would prevent the icon from displaying when Conflict Catcher is present. }
- { 1.0.3: }
- { Now checks for the required system functionality and does nothing if absent. }
- { 1.0.4: }
- { Added STANDALONE preprocessor flag to allow separate compilation. }
- { Changed calling convention to 'Pascal' so that people without a C compiler could use it. }
- { 1.1.0: }
- { Support System 6 trivial, and support the advance boolean, removed the asm code - PNL }
- { Basically, added the good features of ShowIcon7 to this in a hopeless attempt to }
- { make ShowInit the "One True Show Icon Code". }
-
- uses
- {$ifc undefined THINK_Pascal}
- OSUtils, Resources, Memory, QuickDraw,
- {$endc}
- Icons;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { The ShowINIT mechanism works by having each INIT read/write data from these globals. }
-
- type
- LMShowInitRecord = packed record
- LMVCheckSum: integer;
- LMVCoord: integer;
- LMHCoord: integer;
- LMHCheckSum: integer;
- end;
- LMShowInitRecordPtr = ^LMShowInitRecord;
-
- const
- LMShowInitRecordAddr = $928; { Low Memory address of record }
-
- { prototypes }
- function CheckSum (x: integer): integer;
- forward;
- procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
- forward;
- procedure AdvanceIconPosition (var iconRect: Rect);
- forward;
- procedure DrawBWIcon (iconId: integer; var icon_rect: Rect; visible: Boolean);
- forward;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Main routine. }
- { This must be the first routine for THINK C's "Custom Header" option to work }
-
- {$ifc not undefined THINK_Pascal}
- type
- QDGlobals = record
- privates: packed array[0..75] of CHAR;
- randSeed: LONGINT;
- screenBits: BitMap;
- arrow: Cursor;
- dkGray: Pattern;
- ltGray: Pattern;
- gray: Pattern;
- black: Pattern;
- white: Pattern;
- thePort: GrafPtr;
- end;
- type
- IconAlignmentType = integer;
- IconTransformType = integer;
-
- const
- ttNone = $0;
- atNone = $0;
-
- function PlotIconID (var theRect: Rect; align: IconAlignmentType; transform: IconTransformType; theResID: INTEGER): OSErr;
- inline
- $303C, $0500, $ABC9;
-
- {$endc}
-
- type
- QDStorage = record
- qd: QDGlobals; { Storage for the QuickDraw globals }
- qdGlobalsPtr: Ptr; { A5 points to this place; it will contain a pointer to qd }
- end;
-
- procedure ShowIcon7 (iconFamilyID: integer; advance: Boolean);
- var
- oldA5: longInt;
- qds: QDStorage; { Fake QD globals }
- colorPort: CGrafPort;
- bwPort: GrafPort;
- destRect: Rect;
- environment: SysEnvRec; { machine configuration. }
- junk: OSErr;
- begin
-
- oldA5 := SetA5(longInt(@qds.qdGlobalsPtr)); { Tell A5 to point to the end of the fake QD Globals }
- InitGraf(@qds.qd.thePort); { Initialize the fake QD Globals }
-
- { find out what kind of machine this is. }
- junk := SysEnvirons(curSysEnvVers, environment);
-
- ComputeIconRect(destRect, qds.qd.screenBits.bounds); { Compute where the icon should be drawn }
-
- if (environment.systemVersion >= $0700) & environment.hasColorQD then begin
- OpenCPort(@colorPort);
- DrawBWIcon(iconFamilyID, destRect, false);
- junk := PlotIconID(destRect, atNone, ttNone, iconFamilyID);
- CloseCPort(@colorPort);
- end
- else begin
- OpenPort(@bwPort);
- DrawBWIcon(iconFamilyID, destRect, true);
- ClosePort(@bwPort);
- end;
-
- if advance then begin
- AdvanceIconPosition(destRect);
- end;
-
- oldA5 := SetA5(oldA5); { Restore A5 to its previous value }
- end;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { A checksum is used to make sure that the data in there was left by another ShowINIT-aware INIT. }
-
- function CheckSum (x: integer): integer; { This is the shortest C equivalent I could find. }
- begin
- CheckSum := BXOR(BOR(BSL(x, 1), BSR(x, 15)), $1021);
- end;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Compute where the icon should be displayed and update the shared globals. }
-
- procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
- var
- lmp: LMShowInitRecordPtr;
- begin
- lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
- if (CheckSum(lmp^.LMHCoord) <> lmp^.LMHCheckSum) then begin { If we are first, we need to initialize the shared data. }
- lmp^.LMHCoord := 8;
- end;
- if (CheckSum(lmp^.LMVCoord) <> lmp^.LMVCheckSum) then begin
- lmp^.LMVCoord := bounds.bottom - 40;
- end;
-
- if (lmp^.LMHCoord + 34 > bounds.right) then begin { Check whether we must wrap }
- iconRect.left := 8;
- iconRect.top := lmp^.LMVCoord - 40;
- end
- else begin
- iconRect.left := lmp^.LMHCoord;
- iconRect.top := lmp^.LMVCoord;
- end;
- iconRect.right := iconRect.left + 32;
- iconRect.bottom := iconRect.top + 32;
- end;
-
- procedure AdvanceIconPosition (var iconRect: Rect);
- var
- lmp: LMShowInitRecordPtr;
- begin
- lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
- lmp^.LMHCoord := iconRect.left + 40; { Update the shared data }
- lmp^.LMVCoord := iconRect.top;
- lmp^.LMHCheckSum := CheckSum(lmp^.LMHCoord);
- lmp^.LMVCheckSum := CheckSum(lmp^.LMVCoord);
- end;
-
- { DrawBWIcon() draws the 'ICN#' member of the icon family. }
-
- procedure DrawBWIcon (iconId: integer; var icon_rect: Rect; visible: Boolean);
- var
- icon: Handle;
- source, destination: BitMap;
- empty_mask: RgnHandle;
- port: GrafPtr;
- begin
- icon := Get1Resource('ICN#', iconId);
- if (icon <> nil) then begin
- HLock(icon);
-
- { prepare the source and destination bitmaps. }
- source.baseAddr := Ptr(longInt(icon^) + 128); { mask address. }
- source.rowBytes := 4;
- SetRect(source.bounds, 0, 0, 32, 32);
- GetPort(port);
- destination := port^.portBits;
- if visible then begin
- empty_mask := nil;
- end
- else begin
- empty_mask := NewRgn;
- end;
-
- { transfer the mask. }
- CopyBits(source, destination, source.bounds, icon_rect, srcBic, empty_mask);
-
- { and the icon. }
- source.baseAddr := icon^;
- CopyBits(source, destination, source.bounds, icon_rect, srcOr, empty_mask);
-
- if (empty_mask <> nil) then begin
- DisposeRgn(empty_mask);
- end;
- end;
- end;
-
- end.